home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / interp / class.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  11.0 KB  |  440 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: class.c,v 1.12 94/11/30 16:16:06 rgs Exp $
  27. *
  28. * This file implements classes.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include "../compat/std-c.h"
  33.  
  34. #include "mindy.h"
  35. #include "gc.h"
  36. #include "type.h"
  37. #include "list.h"
  38. #include "sym.h"
  39. #include "bool.h"
  40. #include "obj.h"
  41. #include "error.h"
  42. #include "def.h"
  43. #include "print.h"
  44. #include "class.h"
  45. #include "extern.h"
  46. #include "instance.h"
  47.  
  48. obj_t obj_ClassClass = 0;
  49. obj_t obj_StaticTypeClass = NULL; /* type of static pointer classes */
  50.  
  51.  
  52.  
  53. /* Class constructors. */
  54.  
  55. obj_t make_builtin_class(int (*scavenge)(struct object *ptr),
  56.              obj_t (*transport)(obj_t object))
  57. {
  58.     obj_t res = alloc(obj_ClassClass, sizeof(struct class));
  59.  
  60.     init_class_type_stuff(res);
  61.     CLASS(res)->abstract_p = FALSE;
  62.     CLASS(res)->sealed_p = TRUE;
  63.     CLASS(res)->library = NULL;
  64.     CLASS(res)->scavenge = scavenge;
  65.     CLASS(res)->transport = transport;
  66.     CLASS(res)->print = NULL;
  67.     /* These really want to be an obj_t, but we don't have any good obj_t's */
  68.     /* to fill them in with yet. */
  69.     CLASS(res)->debug_name = NULL;
  70.     CLASS(res)->superclasses = NULL;
  71.     CLASS(res)->cpl = NULL;
  72.     CLASS(res)->direct_subclasses = NULL;
  73.     CLASS(res)->all_subclasses = NULL;
  74.  
  75.     return res;
  76. }
  77.  
  78. static int scav_lose(struct object *ptr)
  79. {
  80.     lose("Found an instance of an abstract class?\n");
  81.     return 0;
  82. }
  83.  
  84. static obj_t trans_lose(obj_t obj)
  85. {
  86.     lose("Found an instance of an abstract class?\n");
  87.     return NULL;
  88. }
  89.  
  90. obj_t make_abstract_class(boolean sealed_p)
  91. {
  92.     obj_t res = make_builtin_class(scav_lose, trans_lose);
  93.  
  94.     CLASS(res)->abstract_p = TRUE;
  95.     CLASS(res)->sealed_p = sealed_p;
  96.  
  97.     return res;
  98. }
  99.  
  100.  
  101. /* CPL computation. */
  102.  
  103. struct cpd {
  104.     obj_t class;
  105.     struct cpd_chain *supers;
  106.     struct cpd_chain *after;
  107.     int count;
  108. };
  109.  
  110. struct cpd_chain {
  111.     struct cpd *cpd;
  112.     struct cpd_chain *next;
  113. };
  114.  
  115. static struct cpd_chain *cpds = NULL;
  116. static int class_count = 0;
  117.  
  118. static void push_cpd(struct cpd *cpd, struct cpd_chain **chain)
  119. {
  120.     struct cpd_chain *new = (struct cpd_chain *)malloc(sizeof(struct cpd));
  121.  
  122.     new->cpd = cpd;
  123.     new->next = *chain;
  124.     *chain = new;
  125. }
  126.  
  127. static struct cpd *pop_cpd(struct cpd_chain **chainptr)
  128. {
  129.     struct cpd_chain *chain = *chainptr;
  130.     struct cpd *cpd = chain->cpd;
  131.  
  132.     *chainptr = chain->next;
  133.     free(chain);
  134.  
  135.     return cpd;
  136. }
  137.  
  138. static void free_cpd_chain(struct cpd_chain *chain)
  139. {
  140.     while (chain != NULL) {
  141.     struct cpd_chain *next = chain->next;
  142.     free(chain);
  143.     chain = next;
  144.     }
  145. }
  146.  
  147. static struct cpd *find_cpd(obj_t class);
  148.  
  149. static struct cpd *compute_cpd(obj_t class, obj_t supers)
  150. {
  151.     struct cpd *cpd = (struct cpd *)malloc(sizeof(struct cpd));
  152.  
  153.     cpd->class = class;
  154.     cpd->supers = NULL;
  155.     cpd->after = NULL;
  156.     cpd->count = 0;
  157.     push_cpd(cpd, &cpds);
  158.     class_count++;
  159.  
  160.     if (supers != obj_Nil) {
  161.     struct cpd *prev_super_cpd = find_cpd(HEAD(supers));
  162.     push_cpd(prev_super_cpd, &cpd->supers);
  163.     push_cpd(prev_super_cpd, &cpd->after);
  164.     prev_super_cpd->count++;
  165.     while ((supers = TAIL(supers)) != obj_Nil) {
  166.         struct cpd *super_cpd = find_cpd(HEAD(supers));
  167.         push_cpd(super_cpd, &cpd->supers);
  168.         push_cpd(super_cpd, &cpd->after);
  169.         push_cpd(super_cpd, &prev_super_cpd->after);
  170.         super_cpd->count += 2;
  171.         prev_super_cpd = super_cpd;
  172.     }
  173.     }
  174.     return cpd;
  175. }
  176.  
  177. static struct cpd *find_cpd(obj_t class)
  178. {
  179.     struct cpd_chain *ptr;
  180.  
  181.     for (ptr = cpds; ptr != NULL; ptr = ptr->next)
  182.     if (ptr->cpd->class == class)
  183.         return ptr->cpd;
  184.  
  185.     return compute_cpd(class, CLASS(class)->superclasses);
  186. }
  187.  
  188. static struct cpd *tie_breaker(struct cpd_chain **candidates, obj_t rcpl)
  189. {
  190.     obj_t remaining, supers;
  191.     struct cpd_chain **prev, *ptr;
  192.  
  193.     for (remaining = rcpl; remaining != obj_Nil; remaining = TAIL(remaining)) {
  194.     supers = CLASS(HEAD(remaining))->superclasses;
  195.     for (prev = candidates; (ptr = *prev) != NULL; prev = &ptr->next)
  196.         if (memq(ptr->cpd->class, supers))
  197.         return pop_cpd(prev);
  198.     }
  199.     lose("Can't happen.\n");
  200.     return NULL;
  201. }
  202.  
  203. static obj_t slow_compute_cpl(obj_t class, obj_t superclasses)
  204. {
  205.     struct cpd_chain *candidates;
  206.     struct cpd *candidate;
  207.     obj_t rcpl;
  208.     int count;
  209.     struct cpd_chain *after;
  210.  
  211.     cpds = NULL;
  212.     class_count = 0;
  213.     candidates = NULL;
  214.     push_cpd(compute_cpd(class, superclasses), &candidates);
  215.     free_cpd_chain(cpds);
  216.     cpds = NULL;
  217.  
  218.     rcpl = obj_Nil;
  219.     for (count = 0; count < class_count; count++) {
  220.     if (candidates == NULL)
  221.         error("Inconsistent CPL");
  222.     if (candidates->next != NULL)
  223.         candidate = tie_breaker(&candidates, rcpl);
  224.     else
  225.         candidate = pop_cpd(&candidates);
  226.  
  227.     rcpl = pair(candidate->class, rcpl);
  228.  
  229.     free_cpd_chain(candidate->supers);
  230.     for (after = candidate->after; after != NULL; after = after->next) {
  231.         after->cpd->count--;
  232.         if (after->cpd->count == 0)
  233.         push_cpd(after->cpd, &candidates);
  234.     }
  235.     free_cpd_chain(candidate->after);
  236.     free(candidate);
  237.     }
  238.  
  239.     return nreverse(rcpl);
  240. }
  241.  
  242. static obj_t compute_cpl(obj_t class, obj_t superclasses)
  243. {
  244.     if (superclasses == obj_Nil)
  245.     return list1(class);
  246.     else if (TAIL(superclasses) == obj_Nil)
  247.     return pair(class, CLASS(HEAD(superclasses))->cpl);
  248.     else
  249.     return slow_compute_cpl(class, superclasses);
  250. }
  251.  
  252.  
  253. /* Class initialization. */
  254.  
  255. void setup_class_supers(obj_t class, obj_t supers)
  256. {
  257.     obj_t cpl, scan;
  258.     boolean some_static = FALSE, all_static = TRUE;
  259.  
  260.     for (scan = supers; scan != obj_Nil; scan = TAIL(scan)) {
  261.     obj_t super = HEAD(scan);
  262.     if (CLASS(super)->sealed_p
  263.           && CLASS(super)->library != CLASS(class)->library)
  264.         error("Can't add subclasses to sealed class %=", super);
  265.     if (CLASS(super)->superclasses == obj_False
  266.           || CLASS(super)->superclasses == NULL)
  267.         error("Attempt to use %= before it is initialized", super);
  268.         
  269.     if (object_class(super) == obj_StaticTypeClass)
  270.         some_static = TRUE;
  271.     else if (object_class(super) == obj_DefinedClassClass)
  272.         all_static = all_static && (DC(super)->all_slots == obj_Nil);
  273.     else
  274.         all_static = all_static && CLASS(super)->abstract_p;
  275.     }
  276.     
  277.     if (some_static) {
  278.     /* If we inherit from a statically typed pointer class, then we must
  279.        be a statically typed pointer class.  We must therefore act like
  280.        one */
  281.     if (!all_static)
  282.         error("Can't mix normal classes with "
  283.           "statically typed pointer classes in %=", class);
  284.     CLASS(class)->class = obj_StaticTypeClass;
  285.     CLASS(class)->scavenge = scav_c_pointer;
  286.     CLASS(class)->transport = trans_c_pointer;
  287.     shrink(class, sizeof(struct class));
  288.     }
  289.  
  290.     CLASS(class)->superclasses = supers;
  291.     cpl = compute_cpl(class, supers);
  292.     CLASS(class)->cpl = cpl;
  293.  
  294.     for (scan = TAIL(cpl); scan != obj_Nil; scan = TAIL(scan)) {
  295.     obj_t super = HEAD(scan);
  296.     CLASS(super)->all_subclasses
  297.         = pair(class, CLASS(super)->all_subclasses);
  298.     }
  299.     for (scan = supers; scan != obj_Nil; scan = TAIL(scan)) {
  300.     obj_t super = HEAD(scan);
  301.     CLASS(super)->direct_subclasses
  302.         = pair(class, CLASS(super)->direct_subclasses);
  303.     }
  304. }
  305.  
  306. static void vinit_builtin_class(obj_t class, char *name, va_list ap)
  307. {
  308.     obj_t super, supers;
  309.  
  310.     supers = obj_Nil;
  311.     while ((super = va_arg(ap, obj_t)) != NULL)
  312.     supers = pair(super, supers);
  313.     supers = nreverse(supers);
  314.  
  315.     CLASS(class)->debug_name = symbol(name);
  316.     setup_class_supers(class, supers);
  317.     CLASS(class)->direct_subclasses = obj_Nil;
  318.     CLASS(class)->all_subclasses = obj_Nil;
  319.  
  320.     define_class(name, class);
  321. }
  322. #if _USING_PROTOTYPES_
  323. void init_builtin_class(obj_t class, char *name, ...)
  324. {
  325.     va_list ap;
  326.  
  327.     va_start(ap, name);
  328.     vinit_builtin_class(class, name, ap);
  329.     va_end(ap);
  330. }
  331. #else
  332. void init_builtin_class(va_alist) va_dcl
  333. {
  334.     va_list ap;
  335.     obj_t class;
  336.     char *name;
  337.  
  338.     va_start(ap);
  339.     class = va_arg(ap, obj_t);
  340.     name = va_arg(ap, char *);
  341.     vinit_builtin_class(class, name, ap);
  342.     va_end(ap);
  343. }
  344. #endif
  345.  
  346.  
  347. /* Dylan functions. */
  348.  
  349. static obj_t class_name(obj_t class)
  350. {
  351.     return CLASS(class)->debug_name;
  352. }
  353.  
  354. static obj_t direct_superclasses(obj_t class)
  355. {
  356.     return CLASS(class)->superclasses;
  357. }
  358.  
  359. static obj_t direct_subclasses(obj_t class)
  360. {
  361.     return CLASS(class)->direct_subclasses;
  362. }
  363.  
  364. static obj_t all_superclasses(obj_t class)
  365. {
  366.     return CLASS(class)->cpl;
  367. }
  368.  
  369.  
  370. /* Printer support. */
  371.  
  372. static void print_class(obj_t class)
  373. {
  374.     obj_t debug_name = CLASS(class)->debug_name;
  375.  
  376.     if (debug_name != NULL && debug_name != obj_False)
  377.     printf("{class %s}", sym_name(debug_name));
  378.     else
  379.     printf("{anonymous class 0x%08lx}", (unsigned long)class);
  380. }
  381.  
  382.  
  383. /* GC stuff. */
  384.  
  385. static int scav_class(struct object *o)
  386. {
  387.     struct class *c = (struct class *)o;
  388.  
  389.     scavenge(&c->debug_name);
  390.     scavenge(&c->superclasses);
  391.     scavenge(&c->cpl);
  392.     scavenge(&c->direct_subclasses);
  393.     scavenge(&c->all_subclasses);
  394.  
  395.     return sizeof(struct class);
  396. }
  397.  
  398. static obj_t trans_class(obj_t class)
  399. {
  400.     return transport(class, sizeof(struct class));
  401. }
  402.  
  403. void scavenge_class_roots(void)
  404. {
  405.     scavenge(&obj_ClassClass);
  406.     scavenge(&obj_StaticTypeClass);
  407. }
  408.  
  409.  
  410. /* Init stuff. */
  411.  
  412. void make_class_classes(void)
  413. {
  414.     obj_ClassClass = ptr_obj(0);
  415.     obj_ClassClass = make_builtin_class(scav_class, trans_class);
  416.     CLASS(obj_ClassClass)->class = obj_ClassClass;
  417.     obj_StaticTypeClass = make_builtin_class(scav_class, trans_class);
  418. }
  419.  
  420. void init_class_classes(void)
  421. {
  422.     init_builtin_class(obj_ClassClass, "<class>", obj_TypeClass, NULL);
  423.     def_printer(obj_ClassClass, print_class);
  424.     init_builtin_class(obj_StaticTypeClass, "<static-pointer-class>",
  425.                obj_ClassClass, NULL);
  426.     def_printer(obj_StaticTypeClass, print_class);
  427. }
  428.  
  429. void init_class_functions(void)
  430. {
  431.     define_method("class-name", list1(obj_ClassClass), FALSE, obj_False,
  432.           FALSE, obj_ObjectClass, class_name);
  433.     define_method("all-superclasses", list1(obj_ClassClass), FALSE, obj_False,
  434.           FALSE, obj_ObjectClass, all_superclasses);
  435.     define_method("direct-superclasses", list1(obj_ClassClass), FALSE,
  436.           obj_False, FALSE, obj_ObjectClass, direct_superclasses);
  437.     define_method("direct-subclasses", list1(obj_ClassClass), FALSE,
  438.           obj_False, FALSE, obj_ObjectClass, direct_subclasses);
  439. }
  440.